home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / outdef.c < prev    next >
C/C++ Source or Header  |  1992-11-21  |  12KB  |  427 lines
  1. /* outdef.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens, 
  12.         nsens, ifour, nfour, ifield, icode, idelim, icolum, insize, 
  13.         junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr, 
  14.         numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap, 
  15.         iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3, 
  16.         lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod, 
  17.         nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf, 
  18.         irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar, 
  19.         lvntmp;
  20. } tabinf_;
  21.  
  22. #define tabinf_1 tabinf_
  23.  
  24. struct {
  25.     integer iprnta, iprntl, iprntm, iprntn, iprnto, limtim, limpts, lvlcod, 
  26.         lvltim, itl1, itl2, itl3, itl4, itl5, itl6, igoof, nogo, keof;
  27. } flags_;
  28.  
  29. #define flags_1 flags_
  30.  
  31. struct {
  32.     doublereal value[200000];
  33. } blank_;
  34.  
  35. #define blank_1 blank_
  36.  
  37. /* Table of constant values */
  38.  
  39. static integer c__5 = 5;
  40. static integer c__1 = 1;
  41. static integer c__4 = 4;
  42. static integer c__0 = 0;
  43. static integer c__2 = 2;
  44. static integer c__7 = 7;
  45. static integer c__9 = 9;
  46.  
  47. /*<       subroutine outdef(ifld,mode,loct,ltype) >*/
  48. /* Subroutine */ int outdef_(ifld, mode, loct, ltype)
  49. integer *ifld, *mode, *loct, *ltype;
  50. {
  51.     /* Initialized data */
  52.  
  53.     static struct {
  54.     char e_1[152];
  55.     doublereal e_2;
  56.     } equiv_22 = { {'v', ' ', ' ', ' ', ' ', ' ', ' ', ' ', 'v', 'm', ' ',
  57.          ' ', ' ', ' ', ' ', ' ', 'v', 'r', ' ', ' ', ' ', ' ', ' ', 
  58.         ' ', 'v', 'i', ' ', ' ', ' ', ' ', ' ', ' ', 'v', 'p', ' ', 
  59.         ' ', ' ', ' ', ' ', ' ', 'v', 'd', 'b', ' ', ' ', ' ', ' ', 
  60.         ' ', 'i', ' ', ' ', ' ', ' ', ' ', ' ', ' ', 'i', 'm', ' ', 
  61.         ' ', ' ', ' ', ' ', ' ', 'i', 'r', ' ', ' ', ' ', ' ', ' ', 
  62.         ' ', 'i', 'i', ' ', ' ', ' ', ' ', ' ', ' ', 'i', 'p', ' ', 
  63.         ' ', ' ', ' ', ' ', ' ', 'i', 'd', 'b', ' ', ' ', ' ', ' ', 
  64.         ' ', 'o', 'n', 'o', 'i', ' ', ' ', ' ', ' ', 'i', 'n', 'o', 
  65.         'i', ' ', ' ', ' ', ' ', 'h', 'd', '2', ' ', ' ', ' ', ' ', 
  66.         ' ', 'h', 'd', '3', ' ', ' ', ' ', ' ', ' ', 'd', 'i', 'm', 
  67.         '2', ' ', ' ', ' ', ' ', 's', 'i', 'm', '2', ' ', ' ', ' ', 
  68.         ' ', 'd', 'i', 'm', '3', ' ', ' ', ' ', ' '}, 0. };
  69.  
  70. #define aout ((doublereal *)&equiv_22)
  71.  
  72.     static struct {
  73.     char e_1[40];
  74.     doublereal e_2;
  75.     } equiv_23 = { {'m', ' ', ' ', ' ', ' ', ' ', ' ', ' ', 'r', ' ', ' ',
  76.          ' ', ' ', ' ', ' ', ' ', 'i', ' ', ' ', ' ', ' ', ' ', ' ', 
  77.         ' ', 'p', ' ', ' ', ' ', ' ', ' ', ' ', ' ', 'd', ' ', ' ', 
  78.         ' ', ' ', ' ', ' ', ' '}, 0. };
  79.  
  80. #define aopts ((doublereal *)&equiv_23)
  81.  
  82.     static struct {
  83.     char e_1[8];
  84.     doublereal e_2;
  85.     } equiv_24 = { {'(', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  86.  
  87. #define alprn (*(doublereal *)&equiv_24)
  88.  
  89.     static struct {
  90.     char e_1[8];
  91.     doublereal e_2;
  92.     } equiv_25 = { {',', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  93.  
  94. #define acomma (*(doublereal *)&equiv_25)
  95.  
  96.     static struct {
  97.     char e_1[8];
  98.     doublereal e_2;
  99.     } equiv_26 = { {' ', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  100.  
  101. #define ablnk (*(doublereal *)&equiv_26)
  102.  
  103.     static struct {
  104.     char e_1[8];
  105.     doublereal e_2;
  106.     } equiv_27 = { {'v', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  107.  
  108. #define aletv (*(doublereal *)&equiv_27)
  109.  
  110.  
  111.     /* Local variables */
  112.     static doublereal anam;
  113.     extern /* Subroutine */ int find_(), move_();
  114.     static integer ipos;
  115.     extern integer xxor_();
  116.     static integer i;
  117.     static doublereal achek, avsrc;
  118.     static integer idout, ktype, n1, n2;
  119.     static doublereal atype;
  120.     static integer id;
  121.     static doublereal adelim;
  122. #define nodplc ((integer *)&blank_1)
  123. #define cvalue ((complex *)&blank_1)
  124.     extern /* Subroutine */ int alfnum_();
  125.     static doublereal outnam;
  126.  
  127. /*<       implicit double precision (a-h,o-z) >*/
  128.  
  129. /*     this routine constructs the internal list element for an output */
  130. /* variable defined on some input card. */
  131.  
  132. /* spice version 2g.6  sccsid=tabinf 3/15/83 */
  133. /*<       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
  134. /*<      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
  135. /*<      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
  136. /*<      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
  137. /*<      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
  138. /*<      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
  139. /*<      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
  140. /*<      7   irowno,jcolno,nttbr,nttar,lvntmp >*/
  141. /* spice version 2g.6  sccsid=flags 3/15/83 */
  142. /*<       common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts, >*/
  143. /*<      1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof >*/
  144. /* spice version 2g.6  sccsid=blank 3/15/83 */
  145. /*<       common /blank/ value(200000) >*/
  146. /*<       integer nodplc(64) >*/
  147. /*<       complex cvalue(32) >*/
  148. /*<       equivalence (value(1),nodplc(1),cvalue(1)) >*/
  149.  
  150. /*<       integer xxor >*/
  151. /*<       dimension aout(19),aopts(5) >*/
  152. /*<       data aout / 4hv   , 4hvm  , 4hvr  , 4hvi  , 4hvp  , 4hvdb , >*/
  153. /*<      1            4hi   , 4him  , 4hir  , 4hii  , 4hip  , 4hidb , >*/
  154. /*<      2            4honoi, 4hinoi, 4hhd2 , 4hhd3 , 4hdim2, 4hsim2, >*/
  155. /*<      3            4hdim3 / >*/
  156. /*<       data aopts / 1hm, 1hr, 1hi, 1hp, 1hd / >*/
  157. /*<       data alprn, acomma, ablnk, aletv / 1h(, 1h,, 1h , 1hv / >*/
  158.  
  159. /*<       if (nodplc(icode+ifld).ne.1) go to 300 >*/
  160.     if (nodplc[tabinf_1.icode + *ifld - 1] != 1) {
  161.     goto L300;
  162.     }
  163. /*<       anam=value(ifield+ifld) >*/
  164.     anam = blank_1.value[tabinf_1.ifield + *ifld - 1];
  165. /*<       call move(anam,5,ablnk,1,4) >*/
  166.     move_(&anam, &c__5, &ablnk, &c__1, &c__4);
  167. /*<       do 10 i=1,19 >*/
  168.     for (i = 1; i <= 19; ++i) {
  169. /*<       if (xxor(anam,aout(i)).ne.0) go to 10 >*/
  170.     if (xxor_(&anam, &aout[i - 1]) != 0) {
  171.         goto L10;
  172.     }
  173. /*<       idout=i >*/
  174.     idout = i;
  175. /*<       go to 20 >*/
  176.     goto L20;
  177. /*<    10 continue >*/
  178. L10:
  179.     ;}
  180. /*<       go to 300 >*/
  181.     goto L300;
  182.  
  183. /*  further error checking */
  184.  
  185. /*<    20 if (mode.ge.3) go to 25 >*/
  186. L20:
  187.     if (*mode >= 3) {
  188.     goto L25;
  189.     }
  190. /* ...  dc or tran */
  191. /*<       if ((idout.ne.1).and.(idout.ne.7)) go to 300 >*/
  192.     if (idout != 1 && idout != 7) {
  193.     goto L300;
  194.     }
  195. /*<       go to 38 >*/
  196.     goto L38;
  197. /*<    25 if (mode.ge.4) go to 30 >*/
  198. L25:
  199.     if (*mode >= 4) {
  200.     goto L30;
  201.     }
  202. /* ...  ac */
  203. /*<       if (idout.ge.13) go to 300 >*/
  204.     if (idout >= 13) {
  205.     goto L300;
  206.     }
  207. /*<       go to 38 >*/
  208.     goto L38;
  209. /*<    30 if (mode.eq.5) go to 35 >*/
  210. L30:
  211.     if (*mode == 5) {
  212.     goto L35;
  213.     }
  214. /* ...  noise */
  215. /*<       if ((idout.ne.13).and.(idout.ne.14)) go to 300 >*/
  216.     if (idout != 13 && idout != 14) {
  217.     goto L300;
  218.     }
  219. /*<       go to 38 >*/
  220.     goto L38;
  221. /* ...  distortion */
  222. /*<    35 if (idout.lt.15) go to 300 >*/
  223. L35:
  224.     if (idout < 15) {
  225.     goto L300;
  226.     }
  227. /*<    38 ktype=0 >*/
  228. L38:
  229.     ktype = 0;
  230. /*<       ltype=idout >*/
  231.     *ltype = idout;
  232. /*<       if (idout.lt.7) go to 40 >*/
  233.     if (idout < 7) {
  234.     goto L40;
  235.     }
  236. /*<       ktype=1 >*/
  237.     ktype = 1;
  238. /*<       ltype=ltype-6 >*/
  239.     *ltype += -6;
  240. /*<       if (idout.lt.13) go to 40 >*/
  241.     if (idout < 13) {
  242.     goto L40;
  243.     }
  244. /*<       ktype=idout-11 >*/
  245.     ktype = idout - 11;
  246. /*<       ltype=1 >*/
  247.     *ltype = 1;
  248.  
  249. /*  voltage output */
  250.  
  251. /*<    40 id=40+mode >*/
  252. L40:
  253.     id = *mode + 40;
  254. /*<       if (ktype.ne.0) go to 100 >*/
  255.     if (ktype != 0) {
  256.     goto L100;
  257.     }
  258. /*<       if (nodplc(icode+ifld+1).ne.0) go to 300 >*/
  259.     if (nodplc[tabinf_1.icode + *ifld] != 0) {
  260.     goto L300;
  261.     }
  262. /*<       ifld=ifld+1 >*/
  263.     ++(*ifld);
  264. /*<       n1=value(ifield+ifld) >*/
  265.     n1 = (integer) blank_1.value[tabinf_1.ifield + *ifld - 1];
  266. /*<       if (n1.lt.0) go to 300 >*/
  267.     if (n1 < 0) {
  268.     goto L300;
  269.     }
  270. /*<       if(n1.gt.9999) go to 300 >*/
  271.     if (n1 > 9999) {
  272.     goto L300;
  273.     }
  274. /*<       n2=0 >*/
  275.     n2 = 0;
  276. /*<       adelim=value(idelim+ifld) >*/
  277.     adelim = blank_1.value[tabinf_1.idelim + *ifld - 1];
  278. /*<       if (adelim.eq.acomma) go to 45 >*/
  279.     if (adelim == acomma) {
  280.     goto L45;
  281.     }
  282. /*<       if (adelim.ne.ablnk) go to 50 >*/
  283.     if (adelim != ablnk) {
  284.     goto L50;
  285.     }
  286. /*<    45 if (nodplc(icode+ifld+1).ne.0) go to 300 >*/
  287. L45:
  288.     if (nodplc[tabinf_1.icode + *ifld] != 0) {
  289.     goto L300;
  290.     }
  291. /*<       ifld=ifld+1 >*/
  292.     ++(*ifld);
  293. /*<       n2=value(ifield+ifld) >*/
  294.     n2 = (integer) blank_1.value[tabinf_1.ifield + *ifld - 1];
  295. /*<       if (n2.lt.0) go to 300 >*/
  296.     if (n2 < 0) {
  297.     goto L300;
  298.     }
  299. /*<       if(n2.gt.9999) go to 300 >*/
  300.     if (n2 > 9999) {
  301.     goto L300;
  302.     }
  303. /*<    50 outnam=ablnk >*/
  304. L50:
  305.     outnam = ablnk;
  306. /*<       ipos=1 >*/
  307.     ipos = 1;
  308. /*<       call alfnum(n1,outnam,ipos) >*/
  309.     alfnum_(&n1, &outnam, &ipos);
  310. /*<       ipos=5 >*/
  311.     ipos = 5;
  312. /*<       call alfnum(n2,outnam,ipos) >*/
  313.     alfnum_(&n2, &outnam, &ipos);
  314. /*<       call find(outnam,id,loct,0) >*/
  315.     find_(&outnam, &id, loct, &c__0);
  316. /*<       nodplc(loct+2)=n1 >*/
  317.     nodplc[*loct + 1] = n1;
  318. /*<       nodplc(loct+3)=n2 >*/
  319.     nodplc[*loct + 2] = n2;
  320. /*<       go to 400 >*/
  321.     goto L400;
  322.  
  323. /*  current output */
  324.  
  325. /*<   100 if (ktype.ne.1) go to 200 >*/
  326. L100:
  327.     if (ktype != 1) {
  328.     goto L200;
  329.     }
  330. /*<       if (nodplc(icode+ifld+1).ne.1) go to 300 >*/
  331.     if (nodplc[tabinf_1.icode + *ifld] != 1) {
  332.     goto L300;
  333.     }
  334. /*<       ifld=ifld+1 >*/
  335.     ++(*ifld);
  336. /*<       avsrc=value(ifield+ifld) >*/
  337.     avsrc = blank_1.value[tabinf_1.ifield + *ifld - 1];
  338. /*<       achek=avsrc >*/
  339.     achek = avsrc;
  340. /*<       call move(achek,2,ablnk,1,7) >*/
  341.     move_(&achek, &c__2, &ablnk, &c__1, &c__7);
  342. /*<       if (achek.ne.aletv) go to 300 >*/
  343.     if (achek != aletv) {
  344.     goto L300;
  345.     }
  346. /*<       call find(avsrc,id,loct,0) >*/
  347.     find_(&avsrc, &id, loct, &c__0);
  348. /*<       call find(avsrc,9,nodplc(loct+2),0) >*/
  349.     find_(&avsrc, &c__9, &nodplc[*loct + 1], &c__0);
  350. /*<       nodplc(loct+5)=1 >*/
  351.     nodplc[*loct + 4] = 1;
  352. /*<       go to 400 >*/
  353.     goto L400;
  354.  
  355. /*  noise or distortion outputs */
  356.  
  357. /*<   200 id=44 >*/
  358. L200:
  359.     id = 44;
  360. /*<       if (ktype.ge.4) id=id+1 >*/
  361.     if (ktype >= 4) {
  362.     ++id;
  363.     }
  364. /*<       if (value(idelim+ifld).ne.alprn) go to 220 >*/
  365.     if (blank_1.value[tabinf_1.idelim + *ifld - 1] != alprn) {
  366.     goto L220;
  367.     }
  368. /*<       if (nodplc(icode+ifld+1).ne.1) go to 300 >*/
  369.     if (nodplc[tabinf_1.icode + *ifld] != 1) {
  370.     goto L300;
  371.     }
  372. /*<       ifld=ifld+1 >*/
  373.     ++(*ifld);
  374. /*<       atype=value(ifield+ifld) >*/
  375.     atype = blank_1.value[tabinf_1.ifield + *ifld - 1];
  376. /*<       call move(atype,2,ablnk,1,7) >*/
  377.     move_(&atype, &c__2, &ablnk, &c__1, &c__7);
  378. /*<       do 210 i=1,5 >*/
  379.     for (i = 1; i <= 5; ++i) {
  380. /*<       if (atype.ne.aopts(i)) go to 210 >*/
  381.     if (atype != aopts[i - 1]) {
  382.         goto L210;
  383.     }
  384. /*<       ltype=i+1 >*/
  385.     *ltype = i + 1;
  386. /*<       go to 220 >*/
  387.     goto L220;
  388. /*<   210 continue >*/
  389. L210:
  390.     ;}
  391. /*<       go to 300 >*/
  392.     goto L300;
  393. /*<   220 call find(anam,id,loct,0) >*/
  394. L220:
  395.     find_(&anam, &id, loct, &c__0);
  396. /*<       nodplc(loct+2)=0 >*/
  397.     nodplc[*loct + 1] = 0;
  398. /*<       nodplc(loct+5)=ktype >*/
  399.     nodplc[*loct + 4] = ktype;
  400. /*<       go to 400 >*/
  401.     goto L400;
  402.  
  403. /*  errors */
  404.  
  405. /*<   300 igoof=1 >*/
  406. L300:
  407.     flags_1.igoof = 1;
  408.  
  409. /*  finished */
  410.  
  411. /*<   400 return >*/
  412. L400:
  413.     return 0;
  414. /*<       end >*/
  415. } /* outdef_ */
  416.  
  417. #undef cvalue
  418. #undef nodplc
  419. #undef aletv
  420. #undef ablnk
  421. #undef acomma
  422. #undef alprn
  423. #undef aopts
  424. #undef aout
  425.  
  426.  
  427.